home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
system
/
stack.zip
/
MANUAL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-12-10
|
16KB
|
562 lines
PROGRAM MANUAL;
const
{ See documentation for notes on how to modify these constants }
bold = #02; {wordstar bold face}
double = #04;
pagelines = 66; {default lines per printed page}
tab_posn = 10;
striptop = 127; {used to strip top bit off bytes}
{colours for monitor control}
lightgrey = 7;
black = 0;
lightblue = 9;
yellow = 14;
title = ' Documentation Display System - Version 1.4, Dec 87';
author = ' by Shane Bergl';
scrnsize = 21;
PageWidth = 95;
FormFeed = #12;
ctrla = #01; {control a char}
onefox = #31; { 1F hex}
cr = #13; {carriage return}
lf = #10; {line feed}
pgup = #73; {PgUp key less ESC code}
pgdn = #81; {PgDn key less ESC code}
lnup = #72; {up arrow less ESC code}
lndn = #80; {down arrow less ESC code}
nd = #79; {End key less ESC code}
home = #71; {home key less ESC code}
esc = #27;
blank = #32;
maxline = 20; {max lines per screen}
firstline = 2; {first line for text}
text_size = 512;
space80 =
' ';
screen = true;
printer = false;
type
filename = string[12];
line = record
detail : string[75];
sect : integer;
end;
scr = array[1..20] of line;
scrn_ptr = ^scrn_type;
scrn_type = record
scrn : scr;
next_scr : scrn_ptr;
end;
workstr = string[79];
buff = array[1..512] of byte;
var
infile : file of buff;
doco : file of workstr;
index : file of scr;
testfile : text;
doco_file_name : filename;
heading,
boldface,
finished : boolean;
size_of_file,
curline,
printlength : integer;
curscr,
contents : scrn_ptr;
key : char;
{----------------------------------------------------------}
procedure highon;
begin
textbackground(lightgrey);
textcolor(black);
end;
{----------------------------------------------------------}
procedure highoff;
begin
textbackground(lightblue);
textcolor(yellow);
end;
{----------------------------------------------------------}
procedure init;
var result : integer;
Function exists(name: filename): boolean;
var fp : file;
begin
Assign(fp,Name);
{$I-} reset(fp); {$I+}
If IOresult <> 0 then
exists := False
else
exists := True;
{end if}
close(fp);
end { exists };
Procedure checkfiles;
begin
If ParamCount = 0 then begin
Write('Enter documentation name: ');
readln(doco_file_name);
end
else begin
doco_file_name := ParamStr(1);
end;
If Not exists(doco_file_name + '.DOC') then
if not exists(doco_file_name + '.IDX')
and not exists(doco_file_name + '.DOK') then begin
Writeln('ERROR -- documentation not found: ',doco_file_name);
Halt;
end; {if}
end {checkfiles};
begin {init}
clrscr;
checkfiles;
if ParamCount < 2 then
Printlength := pagelines
else
val(ParamStr(2),PrintLength,result);
{end if}
PrintLength := PrintLength - 6; {3 lines each for header and footer}
highoff;
gotoxy(1, 10);
writeln(' ':29, 'Please wait', ' ':39);
{a quick bit of publicity}
writeln;
writeln(title, ' ':78-length(title));
writeln(author, ' ':78-length(author));
writeln;
{end of ad}
contents := nil;
curline := 1;
finished := false;
curscr := nil;
end;
{----------------------------------------------------------}
Function CmdLine(inbuf : workstr) : boolean;
begin
if (inbuf[1] = '.') and ((inbuf[2]='P')or(inbuf[2]='p'))
and ((inbuf[3]='A')or(inbuf[3]='a')) then
CmdLine := true
else
CmdLine := false;
{end if}
end;
{----------------------------------------------------------}
procedure print(lines2print:integer; screen:boolean; var stopped:boolean;
var linecount:integer);
var cur_row : integer;
prtstr,
printstr,
dupe_str : workstr;
dupe : boolean;
i : integer;
begin
cur_row := 0;
if not screen then begin
gotoxy(1,scrnsize+firstline+1);
highon;
write('Printing, press any key to abort ');
highoff;
end {if};
repeat
read(doco, printstr);
if CmdLine(printstr) then
if not screen then
cur_row := printlength
else
cur_row := cur_row
{end if} {Note: dummy statement required so IF..THEN..ELSEs work properly}
else begin
cur_row := succ(cur_row);
dupe_str := '';
prtstr := '';
dupe := false;
for i := 1 to length(PrintStr) do begin
if (printstr[i] >= blank) or (printstr[i] = bold)
or (printstr[i] = double) then
if (printstr[i] = bold) or (printstr[i] = double) then
dupe := not(dupe)
else
if dupe then
dupe_str := dupe_str + PrintStr[i]
else
dupe_str := dupe_str + ' ';
{end if}
{end if}
{end if}
if printstr[i] >= blank then prtstr := prtstr + printstr[i];
end {for};
if (dupe_str <> '') and not screen then write(lst,' ', dupe_str, cr);
if screen then writeln(prtstr) else writeln(lst,' ', prtstr);
end {if};
until (cur_row >= lines2print) or (cur_row >= printlength) or keypressed or eof(doco);
if keypressed then stopped := true else stopped := false;
linecount := cur_row;
end {print};
{----------------------------------------------------------}
procedure lpr;
var
stopped : boolean;
i,
pagenum : integer;
begin
pagenum := 1;
reset(doco);
repeat
writeln(lst);
writeln(lst, ' ':(pagewidth div 2)-4, pagenum:3);
writeln(lst);
print(printlength, printer, stopped, i);
write(lst, formfeed);
pagenum := succ(pagenum);
until eof(doco) or stopped;
end;
procedure build_contents;
procedure create_index;
{---------------------}
var
i, k, curln, j, chrposn,
sect : integer;
buf : buff;
bite : byte;
outstr : workstr;
ch : char;
line_of_blanks : boolean;
procedure newrec;
begin
curln := 1;
if curscr = nil then begin
new(contents);
curscr := contents;
end
else begin
new(curscr^.next_scr);
curscr := curscr^.next_scr;
end; {if}
curscr^.next_scr := nil;
for k := 1 to maxline do begin
curscr^.scrn[k].detail := ' ';
curscr^.scrn[k].sect := 0;
end; {for}
end;
begin
writeln(' ':28, 'Building Index', ' ':37);
curscr := nil;
heading := false;
line_of_blanks := true;
sect := 0;
outstr := '';
chrposn := 1;
{build index}
curln := maxline;
while not eof(infile) do begin
read(infile, buf);
for i := 1 to 512 do begin
ch := chr(buf[i] and striptop);
case ch of
bold : if heading then begin
heading := false;
end
else begin
heading := true;
curln := curln + 1;
if curln > maxline then newrec;
curscr^.scrn[curln].sect := sect;
if chrposn = 1 then
curscr^.scrn[curln].detail := curscr^.scrn[curln].detail
+ ' '
else
if not line_of_blanks then
curscr^.scrn[curln].detail := curscr^.scrn[curln].detail
+ ' '
else
if chrposn <= tab_posn then
curscr^.scrn[curln].detail